home *** CD-ROM | disk | FTP | other *** search
/ PD Collection CD 1 / PD Collection CD 1.iso / comms / serterm / !SerialTrm / UnCRUNCHED (.txt) < prev   
RISC OS BBC BASIC V Source  |  1995-01-21  |  12KB  |  469 lines

  1.  >!RunImage
  2.  block% 1024
  3. nagg(
  4. $+" at line "+
  5. "OS_Byte",2,2 :
  6.  enable RS423 reciever!
  7. taskname$="Serial Term"
  8. dirname$="<serialterm$dir>"
  9. iconname$="god_0"
  10. menuname$="Serial Term"
  11. taskwinnum%=0
  12. <initialslot%=
  13. OS_ReadVarVal("serialterm$initialslot"))
  14. <startupcomm$=
  15. OS_ReadVarVal("serialterm$startupcommand")
  16. @outbufsize%=
  17. OS_ReadVarVal("serialterm$outputbuffersize"))
  18.  outbufsize%<=260 
  19.  outbufsize%=2048
  20. 4dataformat%=
  21. OS_ReadVarVal("serialterm$data"))
  22. "OS_SerialOp",1,dataformat%
  23. 8outcpp%=
  24. OS_ReadVarVal("serialterm$charsperpoll"))
  25. child_task_handle%=-1
  26. =_running%=1:_error%=2:_paused%=3:_creating%=4:_overrun%=5
  27. _getting%=
  28. :_putting%=
  29. #status%=_creating%:iconstate%=0
  30.  taskid% 8:$taskid%="TASK"
  31. "Wimp_Initialise",200,!taskid%,taskname$ 
  32.  version%,taskhandle%
  33. nagg(
  34. $+" at line "+
  35.  ibm% 256,indic% 24,wblk% 512
  36.  outbuf% outbufsize%
  37. =outb_thresh%=outbufsize%-260:
  38.  threshold for auto-pausing
  39.  outcpp%<0 
  40.  outcpp%=outb_thresh%
  41. "Hourglass_On"
  42. assemble:
  43. sprites:
  44. templates:
  45. initmenus:iconid%=
  46. "Hourglass_Off"
  47. schizo
  48. "OS_ReadMonotonicTime" 
  49.  now%
  50. t_thresh%=now%+100
  51.  status%<>_paused% 
  52. "Wimp_Poll",0,block% 
  53.  reason%
  54. "Wimp_PollIdle",0,block%,t_thresh% 
  55.  reason%
  56.  reason% 
  57.  0 : 
  58.  status% 
  59. 07           
  60.  _running%  : 
  61. inputtest:
  62. buffer_output
  63. 1/           
  64.  _creating% : 
  65. createtaskwindow
  66. 2,           
  67.  _overrun%  : 
  68. buffer_output
  69.          
  70. 4,         
  71. "OS_ReadMonotonicTime" 
  72.  now%
  73. 5:         
  74.  now%>t_thresh% 
  75. iconthang:t_thresh%=now%+50
  76.  2 : 
  77.  "Wimp_OpenWindow",,block%
  78.  3 : 
  79.  "Wimp_CloseWindow",,block%
  80.  9 : 
  81. menuclick(block%)
  82.  6 : 
  83. iconclicked(block%!12,block%!16)
  84.  17,18:
  85. nagg(nagg$)
  86. "Wimp_ReportError","    "+nagg$,1<<4,taskname$
  87. block%!0=-2
  88. block%!4=0   : 
  89.  minx
  90. block%!8=0   : 
  91.  miny
  92. block%!12=48 : 
  93.  maxx
  94. block%!16=76 : 
  95.  maxy
  96. block%!20=&200A 
  97.  1<<8
  98. block%!24=indic%
  99. J+block%!32=
  100.  iconname$:$indic%=iconname$
  101. block%!28=sprites%
  102.  "Wimp_CreateIcon",,block% 
  103.  icon%
  104. =icon%
  105. setibaricn(to$)
  106. $indic%=to$
  107. !wblk%=-2
  108. wblk%!4=iconid%
  109. wblk%!8=0
  110. wblk%!12=0
  111. "Wimp_SetIconState",,wblk%
  112. nagg("Error in death throes!"):
  113. "Wimp_CloseDown",taskhandle%,!taskid%
  114. click_type
  115. c%=block%!8
  116.  c%=2 
  117. popupmenu(
  118.  block%!16 
  119.  &808C1:
  120. message_Output
  121.  &808C2:
  122. message_Ego
  123.  &808C3:
  124. message_Morio
  125.  &80667:
  126. nagg("You can't run two Serial Terms at once!"):
  127.  &80666:
  128. replyeek
  129. initmenus
  130. p"  i%=
  131. initmenu(ibm%,menuname$)
  132. q'  i%=
  133. additem(i%,"Info",0,inf_win%)
  134. r$  i%=
  135. additem(i%,"Restart",0,-1)
  136. s"  i%=
  137. additem(i%,"Pause",0,-1)
  138. t"  i%=
  139. additem(i%,"Quit",-1,-1)
  140. popupmenu(bar%)
  141.  "Wimp_GetPointerInfo",,block%
  142. y2q=!block%:w=block%!4:w%=block%!12:i%=block%!16
  143. w=96+44*4
  144. menu%=ibm%
  145.  "Wimp_CreateMenu",,menu%,q-64,w
  146. }&lastmenu%=menu%:menx%=q-64:meny%=w
  147. templates
  148.  infb% 512,infi% 128
  149. "Wimp_OpenTemplate",,dirname$+".templates"
  150. :inf_win%=
  151. template("info",infb%,infi%,200,-1,sprites%)
  152. "Wimp_CloseTemplate"
  153. template(name$,buf%,ind%,len%,fonts%,sprs%)
  154. "Wimp_LoadTemplate",,buf%,ind%,ind%+len%,fonts%,name$,0
  155. buf%!64=sprs%
  156. "Wimp_CreateWindow",,buf% 
  157.  handle%
  158. =handle%
  159. sprites
  160. #file%=
  161. (dirname$+".SpriteFile")
  162.  file%=0 
  163. nagg("Can't find spritefile!"):
  164. #file%)+128
  165. #file%
  166.  sprites% S%
  167. sprites%!0=S%
  168. sprites%!8=16
  169. "OS_SpriteOp",9+256,sprites%
  170. "OS_SpriteOp",10+256,sprites%,dirname$+".SPRITEFILE"
  171. menuselection(blk%,menu%)
  172. "Wimp_DecodeMenu",,menu%,blk%,wblk%+64
  173. =$(wblk%+64)
  174. menuclick(brtnd%)
  175. ,  item$=
  176. menuselection(brtnd%,lastmenu%)
  177.  item$ 
  178.  "Quit"    : 
  179.  "Pause"   : 
  180. pause
  181.  "Restart" : 
  182. restart
  183. OS_ReadVarVal(A$)
  184.  "OS_ReadVarVal",A$,block%,256,0,3 
  185.  ,,L :A$=""
  186.  a= 0 
  187. A$=A$+
  188. (block%!a)
  189. iconclicked(window%,icon%)
  190.  window%<0 
  191.  icon%=iconid% 
  192. click_type:
  193.  child_task_handle%<>-1 
  194. killtaskwindow
  195. initmenu(menu%,menuname$)
  196. 2$menu%=menuname$:               : 
  197.  menu title
  198. Emenu%?12=7:menu%?13=2           : 
  199.  title foreground & background
  200. Emenu%?14=7:menu%?15=0           : 
  201.  menu  foreground & background
  202. (menuname$)>5 
  203. "  menu%!16=(
  204. (menuname$)+1)*16
  205.   menu%!16=6*16
  206. 2menu%!20=44        : 
  207.  width & height of items
  208. @menu%!24=0                      : 
  209.  vertical gap twixt items
  210. =menu%+28
  211. additem(menu%,text$,last%,sub%)
  212.  last% 
  213.  !menu%=128 
  214.  !menu%=0
  215. menu%!4=sub%
  216. menu%!8=&7000021
  217. $(menu%+12)=text$
  218. =menu%+24
  219. tick(menu%,text$,grey%)
  220.   menu%+=4
  221.     menu%+=24
  222. #    flags%=menu%!8:last%=!menu%
  223.     mt$=$(menu%+12)
  224.  mt$=text$ 
  225.  last%=128
  226.  mt$<>text$ 
  227. nagg("Error - can't (un)tick '"+text$+"' in menu cuz it doesn't exist!"):
  228.  grey% 
  229.  !menu%=last% 
  230.  1<<0 
  231.  !menu%=last% 
  232. (1<<0)
  233. createtaskwindow
  234.  child_task_handle%<>-1 status%=_creating%:
  235.    taskwinnum%+=1
  236. /   cli$="*TASKWINDOW "+
  237. 34+startupcomm$+
  238. 9   cli$+=" -wimpslot "+
  239. (initialslot%)+"K -name "+
  240. #   cli$+="   (Serial Task)"+
  241. 0   cli$+=" -ctrl -task &"+
  242. hex8(taskhandle%)
  243. !   cli$+=" -txt &"+
  244. hex8(666)
  245. "Wimp_StartTask",cli$
  246. .   status%=_running%:
  247. tick(ibm%,"Pause",0)
  248. hex8(n%)
  249. "00000000"+
  250. ~n%,8)
  251. message_Ego
  252.   newhandle%=block%!4
  253. #  child_task_handle%=newhandle%
  254. message_Morio
  255.   child_task_handle%=-1
  256.  status%=_running% 
  257.  status%=_error%
  258. killtaskwindow
  259.  child_task_handle%=-1 
  260. O  !block%=20:block%!4=0:block%!8=0:block%!12=0:block%!16=&808C4:
  261.  die scum!
  262. "Wimp_SendMessage",17,block%,child_task_handle%
  263. schizo
  264. L  !block%=20:block%!4=0:block%!8=0:block%!12=0:block%!16=&80666:
  265.  Aaargh
  266. "Wimp_SendMessage",17,block%,0
  267. replyeek
  268.   from%=block%!4
  269.  from%<>taskhandle% 
  270. E    !block%=20:block%!4=0:block%!8=0:block%!12=0:block%!16=&80667
  271. ,    
  272. "Wimp_SendMessage",17,block%,from%
  273. pausewindow
  274.  child_task_handle%=-1 
  275. 8  status%=_paused%:
  276. iconthang:
  277. tick(ibm%,"Pause",-1)
  278. 2  !block%=20:block%!4=0:block%!8=0:block%!12=0
  279. I  block%!16=&808C6:
  280.  Freeze Motherfucka, or I'll blow your balls off!
  281. "Wimp_SendMessage",17,block%,child_task_handle%
  282. resumewindow
  283.  child_task_handle%=-1 
  284. 8  status%=_running%:
  285. iconthang:
  286. tick(ibm%,"Pause",0)
  287. 2  !block%=20:block%!4=0:block%!8=0:block%!12=0
  288. <  block%!16=&808C7:
  289.  Nice'n'slow, hands on the fender...
  290. "Wimp_SendMessage",17,block%,child_task_handle%
  291. pausewindowA
  292.  child_task_handle%=-1 
  293. 2  !block%=20:block%!4=0:block%!8=0:block%!12=0
  294. I  block%!16=&808C6:
  295.  Freeze Motherfucka, or I'll blow your balls off!
  296. "Wimp_SendMessage",17,block%,child_task_handle%
  297. resumewindowA
  298.  child_task_handle%=-1 
  299. 2  !block%=20:block%!4=0:block%!8=0:block%!12=0
  300. <  block%!16=&808C7:
  301.  Nice'n'slow, hands on the fender...
  302. "Wimp_SendMessage",17,block%,child_task_handle%
  303. restart
  304.  child_task_handle%<>-1 
  305. killtaskwindow
  306. createtaskwindow
  307. iconthang
  308. inputtest
  309. (inputtest) 
  310.   block%!16=&808C0:
  311.  input
  312. "Wimp_SendMessage",17,block%,child_task_handle%
  313.   _getting%=
  314. message_Output
  315. _putting%=
  316.  messageoutput
  317. iconthang
  318.  status% 
  319. 5     
  320.  _running%:stem$="run_"
  321.  _error%:stem$="err_"
  322.  _paused%:stem$="paw_"
  323. 8.    
  324.  _creating%:stem$="god_":iconstate%=1
  325. 9<    
  326.  _overrun%:
  327.  iconstate% stem$="err_" 
  328.  stem$="run_"
  329.   iconstate%=1-iconstate%
  330.  _putting% 
  331.  stem$="put_":iconstate%=1
  332.  _getting% 
  333.  stem$="get_":iconstate%=1
  334.  _getting% 
  335.  _putting% 
  336.  stem$="pet_":iconstate%=1
  337. setibaricn(stem$+
  338. (iconstate%))
  339.   _putting%=
  340.   _getting%=
  341. pause
  342.  status%=_paused% 
  343. resumewindow
  344. tick(ibm%,"Pause",
  345. pausewindow
  346. tick(ibm%,"Pause",
  347. free:=
  348. (Qfree)
  349. used:=
  350. (Qused)
  351. buffer_output
  352.   error%=
  353. (crunchynuts)
  354. free<=outb_thresh%) 
  355.  status%=_overrun%:
  356. pausewindowA
  357.  status%=_overrun% 
  358. used<16 
  359.  status%=_running%:
  360. resumewindowA
  361. assemble
  362.  code% 512
  363.  pass%=0 
  364. P%=code%
  365. [OPTpass%
  366. .outbstart EQUD 0
  367. .outbend   EQUD 0
  368. .outbsize  EQUD outbufsize%
  369. .outbaddr  EQUD outbuf%
  370. .outcpp    EQUD outcpp%
  371. .crunchynuts
  372. c!MOV  R12,#0         \ cout%=0
  373. d'LDR  R11,outbend    \ get outb_end%
  374. e)LDR  R10,outbstart  \ get outb_start%
  375. f)LDR  R9,outbsize    \ get outbufsize%
  376. g%LDR  R8,outbaddr    \ get outbuf%
  377. h%LDR  R7,outcpp      \ get outcpp%
  378. i=MOV  R0,#3          \ use serial_op 3 (for later, dimwit)
  379. .whileconditions
  380. k1CMP    R10,R11      \ if outb_start%=outbend%
  381. BEQ    endwhile
  382. m)CMP    R7,R12       \ 
  383.  outcpp%=cout%
  384. nGBEQ    endwhile     \   we've finished (error will be tested later)
  385. o/.whilebody          \ so I know where I am!
  386. p3LDRB   R1,[R8,R10]  \ char%=outb_start%?outbuf%
  387. q+SWI    "OS_SerialOp"\ see, told you so.
  388. rJBCS    endwhile     \ if an error (ie. buffer full) then goto endwhile
  389. s(ADD    R10,R10,#1   \ outb_start%+=1
  390. t9CMP    R10,R9       \ if out_bstart%=outbufsize% then
  391. Q  R10,#0       \    outb_start%=0
  392. v"ADD    R12,R12,#1   \ cout%+=1
  393. B      whileconditions
  394. .endwhile
  395. MVNCS  R0,#0
  396. MOVCC  R0,#0
  397. STR    R10,outbstart
  398. STR    R11,outbend
  399. MOV    PC,R14
  400. .blockaddr EQUD block%+20
  401. .messageoutput
  402. )LDR    R11,outbend    \ get outb_end%
  403. +LDR    R9,outbsize    \ get outbufsize%
  404. 'LDR    R8,outbaddr    \ get outbuf%
  405. 'LDR    R12,blockaddr  \ fudge ahoy!
  406. /LDR    R7,[R12],#4    \ R7=count, R12->data
  407. .moloop
  408. 7LDRB   R0,[R12],#1    \ get char, increment pointer
  409. 2STRB   R0,[R8,R11]    \ outbuf%?outb_end%=char
  410. *ADD    R11,R11,#1     \ outb_start%+=1
  411. 5CMP    R11,R9         \ 
  412.  outb_end%=outbifsize% 
  413. Q  R11,#0         \   outb_end%=0;
  414. $SUBS   R7,R7,#1       \ size%-=1
  415. -BNE    moloop         \ loop till size%=0
  416. STR    R11,outbend
  417. MOV    PC,R14
  418. .ptrval EQUD block%+20
  419. .blockaddrit EQUD block%
  420. .inputtest
  421. LDR    R11,ptrval
  422. )ADD    R11,R11,#4    \ -> [block%?24]
  423. #MOV    R10,#24        \ counter
  424. MOV    R9,#252-24    \ eek
  425. MOV    R0,#4
  426. .itloop
  427. SWI    "OS_SerialOp"
  428. BCS    enditloop
  429. 4STRB   R1,[R11],#1  \ block%?ptr%=char%; ptr%+=1
  430. %ADD    R10,R10,#1   \ counter%+=1
  431. %SUBS   R9,R9,#1     \ booga booga
  432.  BNE    itloop       \ Yeeha!
  433. .enditloop
  434. MOV    R6,R10
  435. S   R8,R10,#3    \ get counter 
  436. 5BEQ    alignedok    \ if 0 then no need to fudge!
  437. +RSB    R7,R8,#4     \ R7=4-(counter 
  438. :ADD    R10,R10,R7   \ add 'alignment fudge' to counter
  439. .alignedok
  440. LDR    R1,blockaddrit
  441. 2STR    R10,[R1,#0]  \ !block%=
  442. align(size%+24)
  443. 4SUB    R6,R6,#24    \ get actual number of chars
  444. )STR    R6,[R1,#20]  \ block%!20=size%
  445. MOV    R2,#0
  446. STR    R2,[R1,#4]
  447. STR    R2,[R1,#8]
  448. STR    R2,[R1,#12]
  449. MOV    R0,R6
  450. MOVS   PC,R14
  451. .Qfree
  452. LDR    R11,outbstart
  453. LDR    R10,outbend
  454. LDR    R9,outbsize
  455. CMP    R11,R10
  456. SUBGT  R0,R11,R10
  457. SUBLE  R1,R10,R11
  458. SUBLE  R0,R9,R1
  459. MOVS   PC,R14
  460. .Qused
  461. LDR    R11,outbstart
  462. LDR    R10,outbend
  463. LDR    R9,outbsize
  464. CMP    R11,R10
  465. SUBGT  R1,R9,R11
  466. ADDGT  R0,R1,R10
  467. SUBLE  R0,R10,R11
  468. MOVS   PC,R14
  469.